home *** CD-ROM | disk | FTP | other *** search
/ Aminet 3 / Aminet 3 - July 1994.iso / Aminet / util / cli / MagicClip.lha / MAGICCLIP / MagicClip.mod < prev    next >
Encoding:
Text File  |  1993-11-03  |  6.8 KB  |  198 lines
  1. (* --------------------------------------------------------------------------
  2.   :Program.       MagicClip.mod
  3.   :Contents.      Shell interface for Clipboard text
  4.   :Author.        Franz Schwarz
  5.   :Copyright.     Freeware (freely distributable, copyrighted software)
  6.   :Language.      Oberon-2
  7.   :Translator.    Amiga Oberon 3.00
  8.   :History.       v1.0 19-Jul-93 fSchwarz
  9.   :History.       v1.1  5-Aug-93 fSchwarz - workaround for V37 Dos.Flush()
  10.   :History.         enforcer hit (fixed in V39 Dos) when wbStarted, fixed
  11.   :History.         OpenIFF()/CloseIFF() ressource freeing bug
  12.   :History.       v1.2  5-Aug-93 fSchwarz - fixed magic newline insertion
  13.   :History.         added environment variable support for ID text that
  14.   :History.         separates 2 chunks & for ID text at the end of all text
  15.   :History.         added CTRL_C break checking
  16.   :Address.       Mühlenstraße 2, D-78591 Durchhausen, Germany / R.F.A.
  17.   :Address.       uucp: Franz.Schwarz@mil.ka.sub.org; Fido: 2:241/7506.18
  18.   :Remark.        Amiga-Oberon 3.00 checks string pointers to be even if
  19.   :Remark.        OddChk is enabled: thus don't compile with OddChk.
  20.   :Usage.         "UNIT/K/N,GET/S,FILE/K,PUT/F"
  21. -------------------------------------------------------------------------- *)
  22.  
  23. MODULE MagicClip;
  24.  
  25. IMPORT 
  26.   st: Strings, e: Exec, d: Dos, I: Intuition, iff: IFFParse, 
  27.   o: OberonLib, y: SYSTEM;
  28.  
  29. CONST
  30.   verTag = "\000$VER: MagicClip 1.2 (5.8.93) © Franz.Schwarz@mil.ka.sub.org - Freeware";
  31.   
  32.   templ = "UNIT/K/N,GET/S,FILE/K,PUT/F";
  33.   
  34.   varSize      = 256;
  35.   chunkSepName = "MAGICCLIPCHUNKSEP";
  36.   endTxtName   = "MAGICCLIPENDTXT";
  37.  
  38. TYPE
  39.   LStrPtr = UNTRACED POINTER TO ARRAY MAX (LONGINT)-1 OF CHAR;
  40.  
  41.   LongIntStruct = STRUCT
  42.     l: LONGINT;
  43.   END;
  44.  
  45. CONST
  46.   bufSize = 256;
  47.  
  48.   unit0 = LongIntStruct (0);
  49.   
  50.   idFTXT = y.VAL (LONGINT, 'FTXT');
  51.   idCHRS = y.VAL (LONGINT, 'CHRS');
  52.  
  53.   wroteThisChunk = 0;
  54.   wroteLastChunk = 1;
  55.  
  56. TYPE
  57.   ArgsT = STRUCT
  58.     unit: UNTRACED POINTER TO LONGINT;
  59.     get : LONGINT;
  60.     file: LStrPtr;
  61.     put : LStrPtr;
  62.   END;  
  63.  
  64. VAR
  65.   iffh    : iff.IFFHandlePtr;
  66.   cn      : iff.ContextNodePtr;  
  67.   fh      : d.FileHandlePtr;
  68.   rda     : d.RDArgsPtr;
  69.   args    : ArgsT;
  70.   c       : LONGINT;  
  71.   tcnk    : BOOLEAN;
  72.   wrte    : SET;
  73.   buf     : ARRAY bufSize OF CHAR;
  74.   chunksep: ARRAY varSize OF CHAR;
  75.   endtxt  : ARRAY varSize OF CHAR;
  76.   iffopn  : BOOLEAN;
  77.   chseplen: LONGINT;
  78.   endtxlen: LONGINT;
  79.  
  80. PROCEDURE Halt (ret: LONGINT);
  81. BEGIN
  82.   o.Result := ret;
  83.   o.HaltProc ();
  84. END Halt;
  85.   
  86. BEGIN
  87.   IF o.wbStarted THEN I.DisplayBeep (NIL); Halt (d.fail); END;
  88.   IF d.dos.lib.version < 37 THEN
  89.     y.SETREG (0, d.Write(d.Output(), "Need AmigaOS 2.04 or higher!\n", 29));
  90.     Halt (d.fail);
  91.   END;
  92.   IF iff.base = NIL THEN d.PrintF ("Need iffparse.library!\n"); Halt (d.fail); END;
  93.   rda := d.ReadArgs (templ, args, NIL);
  94.   IF rda = NIL THEN Halt (d.fail); END;
  95.   IF args.unit = NIL THEN args.unit := y.ADR (unit0); END;
  96.   IF (args.unit^ < 0) OR (args.unit^ > 255) THEN
  97.     y.SETREG (0, d.SetIoErr (d.badNumber)); Halt (d.fail); 
  98.   END;  
  99.   c := 0; IF args.get # 0 THEN INC (c); END;
  100.   IF args.file # NIL THEN INC (c); END; IF args.put # NIL THEN INC (c); END;
  101.   IF c > 1 THEN y.SETREG (0, d.SetIoErr (d.tooManyArgs)); Halt (d.fail); END;
  102.   IF c < 1 THEN y.SETREG (0, d.SetIoErr (d.requiredArgMissing)); Halt (d.fail); END;
  103.   iffh := iff.AllocIFF ();
  104.   IF iffh = NIL THEN Halt (d.fail); END;
  105.   iffh.stream := y.VAL (LONGINT, iff.OpenClipboard (args.unit^));
  106.   IF iffh.stream = NIL THEN Halt (d.fail); END;
  107.   iff.InitIFFasClip (iffh);
  108.   IF args.get # 0 THEN
  109.     chseplen := d.GetVar (chunkSepName, chunksep, LEN (chunksep), LONGSET{d.binaryVar});
  110.     IF chseplen < 0 THEN COPY ("\n", chunksep); chseplen := 1; END;
  111.     endtxlen := d.GetVar (endTxtName, endtxt, LEN (endtxt), LONGSET{d.binaryVar});
  112.     IF endtxlen < 0 THEN endtxlen := 0; END;
  113.     iffopn := iff.OpenIFF (iffh, iff.read) = 0;
  114.     IF ~iffopn THEN Halt (d.fail); END;
  115.     IF iff.StopChunk (iffh, idFTXT, idCHRS) # 0 THEN Halt (d.fail); END;
  116.     LOOP
  117.       CASE iff.ParseIFF (iffh, iff.iffParseScan) OF
  118.       iff.IFFErrEOC: |
  119.       iff.IFFErrEOF, iff.IFFErrNotIFF:
  120.         IF tcnk THEN Halt (d.ok); ELSE Halt (d.warn); END; |
  121.       0:
  122.         cn := iff.CurrentChunk (iffh);
  123.         IF cn # NIL THEN IF cn.type = idFTXT THEN IF cn.id = idCHRS THEN
  124.           tcnk := TRUE;
  125.           REPEAT
  126.             IF d.ctrlC IN d.CheckSignal (LONGSET {d.ctrlC}) THEN 
  127.               y.SETREG (0, d.SetIoErr (d.break)); Halt (d.fail);
  128.             END;  
  129.             c := iff.ReadChunkBytes (iffh, buf, LEN (buf));
  130.             IF c < 0 THEN Halt (d.fail); END;
  131.             IF c > 0 THEN
  132.               IF (wroteLastChunk IN wrte) & (chseplen > 0) THEN
  133.                 IF d.FWrite (d.Output (), chunksep, 1, chseplen) # chseplen THEN Halt (d.fail); END;
  134.               END;  
  135.               wrte := {wroteThisChunk};
  136.               IF d.FWrite (d.Output (), buf, 1, c) # c THEN Halt (d.fail); END;
  137.             END;  
  138.           UNTIL c < LEN (buf);
  139.           IF wroteThisChunk IN wrte THEN wrte := {wroteLastChunk}; END;
  140.         END; END; END; (* IF *)
  141.       ELSE
  142.         Halt (d.fail);
  143.       END;
  144.     END;
  145.   ELSE
  146.     IF args.file # NIL THEN
  147.       fh := d.Open (args.file^, d.oldFile);
  148.       IF fh = NIL THEN Halt (d.fail); END;
  149.     END;
  150.     iffopn := iff.OpenIFF (iffh, iff.write) = 0;
  151.     IF ~iffopn THEN Halt (d.fail); END;
  152.     IF iff.PushChunk (iffh, idFTXT, iff.idFORM, iff.IFFSizeUnknown) # 0 THEN Halt (d.fail); END;
  153.     IF iff.PushChunk (iffh, 0, idCHRS, iff.IFFSizeUnknown) # 0 THEN Halt (d.fail); END;
  154.     IF fh = NIL THEN
  155.       IF iff.WriteChunkBytes (iffh, args.put^, st.Length (args.put^)) < 0 THEN Halt (d.fail); END;
  156.     ELSE
  157.       LOOP
  158.         IF d.ctrlC IN d.CheckSignal (LONGSET {d.ctrlC}) THEN 
  159.           y.SETREG (0, d.SetIoErr (d.break)); Halt (d.fail);
  160.         END;  
  161.         y.SETREG (0, d.SetIoErr (0));
  162.         c := d.FRead (fh, buf, 1, LEN (buf));
  163.         IF c > 0 THEN
  164.           IF iff.WriteChunkBytes (iffh, buf, c) < 0 THEN Halt (d.fail); END;
  165.         ELSE
  166.           IF d.IoErr () = 0 THEN EXIT; ELSE Halt (d.fail); END;
  167.         END;
  168.       END; (* LOOP *)
  169.     END; (* IF fh = NIL *)
  170.     IF iff.PopChunk (iffh) # 0 THEN Halt (d.fail); END;
  171.     IF iff.PopChunk (iffh) # 0 THEN Halt (d.fail); END;
  172.     Halt (d.ok);
  173.   END;
  174.   
  175.   Halt (-1); (* we should never reach this point! *)
  176.  
  177. CLOSE
  178.   IF fh # NIL THEN d.OldClose (fh); END;
  179.   IF iffh # NIL THEN
  180.     IF iffopn THEN iff.CloseIFF (iffh); END;
  181.     IF iffh.stream # 0 THEN iff.CloseClipboard (y.VAL (e.APTR, iffh.stream)); END;
  182.     iff.FreeIFF (iffh);
  183.   END;
  184.   IF rda # NIL THEN d.FreeArgs (rda); END;
  185.   IF d.dos.lib.version >= 37 THEN 
  186.     IF o.Result > d.warn THEN 
  187.       IF wrte # {} THEN d.PrintF ("\n"); END;
  188.       d.PrintF ("%s failed!\n", y.ADR (verTag[7])); 
  189.     ELSE
  190.       IF (wrte # {}) & (endtxlen > 0) THEN
  191.         IF d.FWrite (d.Output (), endtxt, 1, endtxlen) = 0 THEN END;
  192.       END;  
  193.       d.Flush (d.Output ());
  194.     END;  
  195.   END;
  196. END MagicClip.
  197.  
  198.